################
#PSRM: Explaining Support for Redistribution: Social Insurance Systems and Fairness
#
#Experimental Data
#Figure D 18
#
#Verena Fetscher
#July 2022
####################



##########################
#Load data file
##########################

load("dataLab_SocialInsurance_complete.Rda")


##########################
#Filter for decision-makers
##########################

dfSub<-df[df$Role==1,]


##########################
#Subgroups
##########################

#Segregate types
types<-aggregate(rep(1, length(paste0(dfSub$give_weight,dfSub$ID,dfSub$Role))),
                 by=list(dfSub$give_weight,dfSub$ID,dfSub$Role), sum)
filter(types,Group.3==1)

length(filter(types,Group.1==0&Group.3==1&x>=5)$Group.2)
length(filter(types,Group.1==0&Group.3==1&x>=8)$Group.2)
length(filter(types,Group.1==0&Group.3==1&x>=16)$Group.2)

x<-filter(types,Group.1==0&Group.3==1&x>=5)
x$Group.2



##########################
#Selfish decision-makers
##########################

#keep decision-makers with 4 or more zero transfers from data set
dfSub_self<-dfSub[(dfSub$ID %in% x$Group.2),] 
length(unique(dfSub_self$ID))

dfSub %>%
  filter((dfSub$ID %in% x$Group.2)) %>%
  group_by(ID) %>%
  summarize(mean= mean(give_weight))-> mydf_self

summary(mydf_self$mean)
sd(mydf_self$mean)


##########################
#Comparison benefit-level principle
##########################


#Comparison 1
#Situations
#2-9


sit1<-dfSub_self$situation==2
sit2<-dfSub_self$situation==9


s1 <- dfSub_self$give_weight[sit1]
s2 <- dfSub_self$give_weight[sit2]


mean(dfSub_self$give_weight[sit1],na.rm=T)-
  mean(dfSub_self$give_weight[sit2],na.rm=T)


#Nonparametric test statistics
p<-wilcoxsign_test(s1~s2,data=dfSub_self,
                   distribution="exact") 

p<-paste("p =",as.character(round(pvalue(p),4)), sep=" ")



g1<-ggplot(data=dfSub_self[sit1|sit2,], 
           aes(x=factor(situation), give_weight))+
  geom_boxplot(aes(fill=factor(situation)),width=.5,alpha=.8)+
  stat_summary(fun.y = mean, geom="point",color="white",size=3) +
  ylab("Inequality-reduction in %") +  xlab ("")+ ylim(c(0,120))+
  ggtitle("(a) Absolute endowment\n")+
  theme_minimal()+
  scale_fill_manual(values=c("#CCCCCC","#666666"), 
                    name="",
                    breaks=c("2","9"),
                    labels=c("earnings-related",
                             "flat-rate"))+
  guides(fill=guide_legend(nrow=2,byrow=TRUE))+
  annotate("text", x=1.5, y=117.5, label= p,size=5)+
  theme_bw()+
  theme(panel.border=element_blank(),axis.line=element_line(),legend.text = element_text(size = 14),
        legend.title = element_text(size=14),axis.text=element_text(size=12),
        axis.title=element_text(size=14),axis.text.x = element_blank(),legend.position="none"
  )


#Comparison 2
#Situations
#8-13

sit1<-dfSub_self$situation==8
sit2<-dfSub_self$situation==13

s1 <- dfSub_self$give_weight[sit1]
s2 <- dfSub_self$give_weight[sit2]


mean(dfSub_self$give_weight[sit1],na.rm=T)-
  mean(dfSub_self$give_weight[sit2],na.rm=T)


#Nonparametric test statistics
p<-wilcoxsign_test(s1~s2,data=dfSub_self,
                   distribution="approximate") 

p<-paste("p =",as.character(round(pvalue(p),4)), sep=" ")

g2<-ggplot(data=dfSub_self[sit1|sit2,], 
           aes(x=factor(situation), give_weight))+
  #geom_violin()+
  geom_boxplot(aes(fill=factor(situation)),width=.5,alpha=.8)+
  stat_summary(fun.y = mean, geom="point",color="white",size=3) +
  ylab("") +  xlab ("")+ 
  ggtitle("(b) Inequality and\nhigh replacement")+
  ylim(c(0,120))+
  scale_fill_manual(values=c("#CCCCCC","#666666"), 
                    name="",
                    breaks=c("8","13"),
                    labels=c("earnings-related",
                             "flat-rate"))+
  guides(fill=guide_legend(nrow=2,byrow=TRUE))+
  annotate("text", x=1.5, y=117.5, label= p,size=5)+
  theme_bw()+
  theme(panel.border=element_blank(),axis.line=element_line(),legend.text = element_text(size = 14),
        legend.title = element_text(size=14),axis.text=element_text(size=12),
        axis.title=element_text(size=14),axis.text.x = element_blank(),axis.text.y=element_blank(),
        legend.position="none"
  )


#Comparison 3
#Situations
#6-13

sit1<-dfSub_self$situation==6
sit2<-dfSub_self$situation==13

s1 <- dfSub_self$give_weight[sit1]
s2 <- dfSub_self$give_weight[sit2]


mean(dfSub_self$give_weight[sit1],na.rm=T)-
  mean(dfSub_self$give_weight[sit2],na.rm=T)


#nonparametric test statistics
p<-wilcoxsign_test(s1~s2,data=dfSub_self,
                   distribution="exact") 

p<-paste("p =",as.character(round(pvalue(p),4)), sep=" ")


g3<-ggplot(data=dfSub_self[sit1|sit2,], 
           aes(x=factor(situation), give_weight))+
  #geom_violin()+
  geom_boxplot(aes(fill=factor(situation)),width=.5,alpha=.8)+
  stat_summary(fun.y = mean, geom="point",color="white",size=3) +
  ylab("") +  xlab ("")+ ylim(c(0,120))+
  ggtitle("(c) Inequality and\nlow replacement")+
  theme_minimal()+
  scale_fill_manual(values=c("#CCCCCC","#666666"), 
                    name="",
                    breaks=c("6","13"),
                    labels=c("earnings-related",
                             "flat-rate"))+
  guides(fill=guide_legend(nrow=2,byrow=TRUE))+
  annotate("text", x=1.5, y=117.5, label= p,size=5)+
  theme_bw()+
  theme(panel.border=element_blank(),axis.line=element_line(),legend.text = element_text(size = 14),
        legend.title = element_text(size=14),axis.text=element_text(size=12),
        axis.title=element_text(size=14),axis.text.x = element_blank(),axis.text.y=element_blank(),
        legend.position="none"
  )


##########################
#Figure D.18: Effect of social insurance principle on transfers among selfish participants.
##########################

ggarrange(g1,g2, g3,common.legend = TRUE, legend="bottom",ncol = 3)

ggsave(file="figure_d18.pdf", height = 5.83, width = 8.27, units = "in")

